-- $Id: xpa-io-tio.adb,v 1.24 2005-12-22 14:58:11 bacon Exp $

with ada.unchecked_deallocation;
with system.wch_con;
with system.wch_cnv;

with ada.text_io;

package body xpa.io.tio is

	procedure free is new ada.unchecked_deallocation (tio_type, tio_access);

	procedure open (tio: in out tio_access) is
	begin
		if tio = null then
			tio := new tio_type;
			tio.dynamic := true;	
		end if;

		tio.inbuf_pos := tio.inbuf'first;
		tio.inbuf_last := tio.inbuf'first - 1;
		tio.outbuf_last := tio.outbuf'first - 1;

	exception
		when others =>
			if tio.dynamic = true then
				free (tio);	
			end if;
			raise;
	end open;

	procedure close (tio: in out tio_access) is
	begin
		if tio.dynamic = true then
			free (tio);
		end if;
	end close;

	procedure get (tio: in out tio_access; text: out str; last: out natural) is

		procedure call_input_proc_if_necessary is
			last: natural;
		begin
			if tio.inbuf_pos <= tio.inbuf_last then	
				return;
			end if;
			
			input_proc (tio.input_arg, 3, tio.inbuf, last); -- TODO: proper command code
			if last < tio.inbuf'first then
				-- probably the user input procedure is not properly written.
				raise data_error;
			end if;

			tio.inbuf_pos := tio.inbuf'first;
			tio.inbuf_last := last;
		end call_input_proc_if_necessary;

		function in_char return mchar is
			ch: mchar;
		begin
			call_input_proc_if_necessary;
			ch := tio.inbuf(tio.inbuf_pos);
			tio.inbuf_pos := tio.inbuf_pos + 1;
			return ch;

		exception
			when end_error =>
				-- end of input while composing a character
				raise data_error;
			when others =>
				raise;
		end in_char;

		function get_char is new 
			system.wch_cnv.char_sequence_to_wide_char (in_char);

		wc: wide_character;
	begin
		last := text'first - 1;

		while last < text'last loop

			-- get the first character of a wide character
			call_input_proc_if_necessary;

			-- get a complete wide character
			tio.inbuf_pos := tio.inbuf_pos + 1;
			-- TODO: character encoding...
			wc := get_char (
				tio.inbuf(tio.inbuf_pos - 1), xpa.default_wcem);  
			-- put the wide character into "text"	
			last := last + 1;
			text(last) := wc;

			if wc = WC_NL then
				exit;
			end if;

		end loop;
	end get;

	procedure put (tio: in out tio_access; text: in str) is

		procedure out_char (c: mchar) is
		begin
			tio.outbuf_last := tio.outbuf_last + 1;
			tio.outbuf(tio.outbuf_last) := c;
			if tio.outbuf_last = tio.outbuf'last then
				flush (tio);
			elsif c = MC_NL then
				flush (tio);	
			end if;
		end out_char;

		procedure put_char is new 
			system.wch_cnv.wide_char_to_char_sequence (out_char);

		last: natural;
	begin	
		last := text'first;
		loop
			put_char (text(last), xpa.default_wcem);
			if last = text'last then
				exit;
			end if;
			last := last + 1;
		end loop;
	end put;

	procedure flush (tio: in out tio_access) is
		first: natural;
		last: natural;
	begin 
		first := tio.outbuf'first;

		while first <= tio.outbuf_last loop 
			output_proc (tio.output_arg, 3, 
				tio.outbuf(first..tio.outbuf_last), last);
			first := last + 1;
		end loop;
		
		tio.outbuf_last := tio.outbuf'first - 1;
	end flush;

end xpa.io.tio;
